home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / system_1 / frmsysme.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-10-13  |  5.5 KB  |  119 lines
  1. VERSION 5.00
  2. Begin VB.Form frmSysMenu 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "System Menu Demo"
  5.    ClientHeight    =   2970
  6.    ClientLeft      =   2370
  7.    ClientTop       =   1425
  8.    ClientWidth     =   6045
  9.    Icon            =   "frmSysMenu.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   198
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   403
  14.    Begin VB.CommandButton Command1 
  15.       Caption         =   "&Exit"
  16.       Height          =   390
  17.       Left            =   330
  18.       TabIndex        =   2
  19.       Top             =   2340
  20.       Width           =   750
  21.    End
  22.    Begin VB.Label Label2 
  23.       Caption         =   "Now try to move me, I dare you!  And don't even think about trying to change my size because you can't!"
  24.       Height          =   495
  25.       Left            =   360
  26.       TabIndex        =   1
  27.       Top             =   1200
  28.       Width           =   5295
  29.    End
  30.    Begin VB.Label Label1 
  31.       Caption         =   "Check out my system menu.  Click on my icon in the upper left corner."
  32.       Height          =   375
  33.       Left            =   360
  34.       TabIndex        =   0
  35.       Top             =   600
  36.       Width           =   5295
  37.    End
  38. Attribute VB_Name = "frmSysMenu"
  39. Attribute VB_GlobalNameSpace = False
  40. Attribute VB_Creatable = False
  41. Attribute VB_PredeclaredId = True
  42. Attribute VB_Exposed = False
  43.   Option Explicit
  44.   ' demo project showing how to manipulate a form's system menu
  45.   ' by Bryan Stafford of New Vision Software
  46.  - newvision@imt.net
  47.   ' this demo is released into the public domain "as is" without
  48.   ' warranty or guaranty of any kind.  In other words, use at
  49.   ' your own risk.
  50.   Private Const SC_SIZE As Long = &HF000&
  51.   Private Const SC_MOVE As Long = &HF010&
  52.   Private Const SC_CLOSE As Long = &HF060&
  53.   Private Const SC_MINIMIZE As Long = &HF020&
  54.   Private Const SC_MAXIMIZE As Long = &HF030&
  55.   Private Const SC_NEXTWINDOW As Long = &HF040&
  56.   Private Const SC_PREVWINDOW As Long = &HF050&
  57.   Private Const MF_BYCOMMAND As Long = &H0&
  58.   Private Const MF_STRING As Long = &H0&
  59.   Private Const MF_SEPARATOR As Long = &H800&
  60.   Private Const GWL_WNDPROC As Long = (-4&)
  61.   Private Declare Function GetSystemMenu& Lib "user32" (ByVal hWnd&, ByVal bRevert&)
  62.   Private Declare Function DeleteMenu& Lib "user32" (ByVal hMenu&, _
  63.                                                               ByVal nPosition&, ByVal wFlags&)
  64.   Private Declare Function AppendMenu& Lib "user32" Alias "AppendMenuA" (ByVal hMenu&, _
  65.                                             ByVal wFlags&, ByVal wIDNewItem&, lpNewItem As Any)
  66.                                                                     
  67.   Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, _
  68.                                                               ByVal nIndex&, ByVal dwNewLong&)
  69.                                                               
  70. Private Sub Command1_Click()
  71.   ' the user want's out, so let them out
  72.   Unload Me
  73. End Sub
  74. Private Sub Form_Load()
  75.   ' set the wait cursor in case loading the form takes a while
  76.   Screen.MousePointer = vbHourglass
  77.   Dim hSysMenu&
  78.   ' first thing to do is get the handle to the system menu for this form
  79.   hSysMenu = GetSystemMenu(hWnd, False)
  80.   ' the following removes the close, size, move and maximize items from the system menu.
  81.   ' we don't really care whether or not there is an error so we'll throw away the return value
  82.   ' Note: make sure that you don't show the form before the 'Close' menu item is removed.  If
  83.   '       you do the close button on the titlebar will not be drawn in the disable state.
  84.   Call DeleteMenu(hSysMenu, SC_CLOSE, MF_BYCOMMAND)
  85.   Call DeleteMenu(hSysMenu, SC_SIZE, MF_BYCOMMAND)
  86.   Call DeleteMenu(hSysMenu, SC_MOVE, MF_BYCOMMAND)
  87.   Call DeleteMenu(hSysMenu, SC_MAXIMIZE, MF_BYCOMMAND)
  88.   ' now we'll add the about item to the bottom of the menu. I've left in a commented call to
  89.   ' append a separator incase you decide to remove the call to delete the close item from the menu.
  90.   ' Since we have the last item in AppendMenu declared "As Any" to allow the use of either
  91.   ' string or long paramiters, we need to add the byval so that each will be passed correctly.
  92.   ' one last thing, the amprasand character (&) in the string being assigned to the menus
  93.   ' tells windows to underline the following character in the string which allows the menu item
  94.   ' to be selected by pressing the corrosponding key on the keybord
  95.   'Call AppendMenu(hSysMenu, MF_SEPARATOR, False, ByVal 0&)
  96.   Call AppendMenu(hSysMenu, MF_STRING, IDM_ABOUT, ByVal "&About...")
  97.   ' add some more fun stuff
  98.   Call AppendMenu(hSysMenu, MF_SEPARATOR, False, ByVal 0&)
  99.   Call AppendMenu(hSysMenu, MF_STRING, IDM_WHO, ByVal "&Who Did This Anyway?")
  100.   ' take control of message processing by installing our message handling
  101.   ' routine into the chain of message routines for this window
  102.   procOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf MenuProc)
  103.                           
  104.   ' reset the cursor
  105.   Screen.MousePointer = vbDefault
  106. cantgetsysmenu:
  107.   ' simple error handler
  108.   If Err Then
  109.     Err.Clear
  110.     MsgBox "Unable to load append system menu.", vbExclamation, "System Menu Demo"
  111.     Resume cantgetsysmenu
  112.   End If
  113. End Sub
  114. Private Sub Form_Unload(Cancel As Integer)
  115.   ' give message processing control back to VB
  116.   ' if you don't do this you WILL crash!!!
  117.   Call SetWindowLong(hWnd, GWL_WNDPROC, procOld)
  118. End Sub
  119.